perm filename XM.FAI[DAT,LCS] blob sn#502605 filedate 1983-03-31 generic text, type T, neo UTF8
00100	TITLE XM
00200	;******** FOR THICKER LINES, FIRST TYPE <4> FOR DOTS*4 OR <9> FOR DOTS*9
00300		;↓↓AC DEF
00400	A←1
00500	B←2
00600	C←3
00700	D←4
00800	E←5
00900	L←6
01000	U←7
01100	X←11
01200	Y←12
01300	XD←13
01400	T←15
01500	TT←16
01600	P←17
01700		
01800	LPDL←←69
01900	NBUFS←←4
02000	DSK←←1
02100	XGP←←2
02200	
02300	LMAR←←=0
02400	RMAR←←=1699
02500	WIDTH←←=1700
02600	LBUFL←←=48	;LINE LENGTH IN WORDS
02700	
02800	LSTBIT←←1⊗34
02900	
03000	OVERLAP←←=50
03100	
03200	DOFF←←-=760
03300	
03400	EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
03500	MAILBF:	BLOCK 40
03600	SIGN:	0
03700	LINE:	0
03800	PNTR:	0
03900	
     

00100	BEG:	SETOM LINE
00200		GETLIN LINE		;FOR ERROR PRINTOUT
00300		CALLI
00400		HRRZS LINE		;CLEAR LINE BITS
00500		HRRZI A,CORUP
00600		HRRZM A,JOBAPR
00700		SETOM SSS#
00800		HRRZ A,JOBFF		;RESET CORE WITHOUT A RESET
00900		CORE A,
01000		JRST 4,.
01100	
01200	;FLUSHED BY REG  1-3-76
01300	;	MOVE A,[IPC:20000 ↔ 0]
01400	;	INTENB A,
01500	;
01600	;ADDED BY REG:
01700		MOVEI	A,20000		;REG  MPV
01800		APRENB	A,		;REG  ENABLE OLD WAY!
01900	
02000		MOVE P,[-LPDL,,PDL-1]
02100	;Z	OUTSTR [ASCIZ /OLD? /]
02200		SETZM BIGBOT#
02300		SETZM GO#
02400				;NEXT LINE REPLACES FOLLOWING ;Z SECTION.
02500		JRST FILIN	;******* NO 'OLD' FEATURE IN THIS VERSION. ******
02600	
02700	;Z	INCHWL E
02800	;Z	CAIE E,"B"		; B FOR BIG BOTTOM MARGIN (200=1")
02900	;Z	CAIN E,"b"
03000	;Z	CAIA
03100	;Z	JRST .+3
03200	;Z	SETOM BIGBOT
03300	;Z	JRST GOGO-1
03400	;Z	CAIE E,"L"		; L FOR LEGAL SIZE
03500	;Z	CAIN E,"l"
03600	;Z	JRST LEGLEG
03700	;Z	CAIE E,"G"		;IF 'G' SKIP ALL PROMPTS
03800	;Z	CAIN E,"g"
03900	;Z	CAIA
04000	;Z	JRST PASS
04100	;Z	PUSHJ P,FRD		;GO GET DEFAULT FILE NAME.
04200	GONEW:	PUSHJ P,FRD		;GO GET DEFAULT FILE NAME.
04300	GOGO:	MOVEI =11		;DEFAULT PAGE LENGTH = 11" WITH 'G'
04400		JRST GOGOGO
04500	LEGLEG:	PUSHJ P,FRD
04600	LEGAL:	MOVEI =14		;TYPE 'L' FOR LEGAL SIZE 14"
04700	GOGOGO:	MOVEM GO
04800	;;;	SETOM GO		;FOR SKIPING ALL PROMPTS
04900	;C	CLRBFI			;INSTEAD OF ↑↑
05000		PUSHJ P,INCHLF
05100	OUTSTR [ASCIZ/USING DEFAULT VALUES.
05200	/]
05300		SETZM ROFLG#
05400		HRREI B,-60	;??
05500		JRST PASS2
05600	;ZPASS:	CAIE E,"Y"
05700	;Z	CAIN E,"y"
05800	;Z	JRST INBITS
05900	;Z	CLRBFI
06000		SETZM SPREAD#
06100	FILIN:	OUTSTR [ASCIZ /FILE? (DEFAULT=PLT.PLT) /]
06200		PUSHJ P,FRD
06300		SKIPE GO
06400		JRST GONEW	;IF 'G' IS NAME THEN USE DEFAULT VALUES.
06500		SETZ A,
06600	YAGN1:	HRREI B,-60
06700		SETZM ROFLG
06800	OUTSTR [ASCIZ/ROTATE? /]		;YOU CAN TYPE 'G' FOR GO HERE TOO.
06900		INCHWL E
07000	      	CAIE E,"Y"
07100		CAIN E,"y"
07200		SETOM ROFLG			;ROTATE FLAG NOW SET =-1
07300		CAIE E,"G"
07400		CAIN E,"g"
07500		JRST GOGO
07600		CAIE E,"L"
07700		CAIN E,"l"
07800		JRST LEGAL
07900		PUSHJ P,INCHLF		;GO LOOK FOR THE LINE FEED
08000	;C	CLRBFI
08100		SKIPN ROFLG	;ROTATE?
08200		JRST .+3	;NO, SKIP NEXT
08300	OUTSTR [ASCIZ/ORIGIN X RIGHT OFFSET (DEFAULT=7.0(CENTER))? /]
08400		SKIPA
08500	OUTSTR [ASCIZ/ORIGIN X RIGHT OFFSET (DEFAULT=4.0(CENTER))? /]
08600		PUSHJ P,RNUM
08700		JRST [	PASS2:	HRREI A,-=760 
08800				SKIPE ROFLG	;ROTATE?
08900				HRREI A,-=1400	; YES, DEFAULT = 7"
09000				JRST YDEF]	;GET Y INFO
09100		IMULI A,=100
09200		CAIN C,"."		;DECIMAL POINT?
09300		JRST [	INCHWL C
09400			CAIN C,15
09500			INCHWL C
09600			CAIL C,"0"
09700			CAILE C,"9"
09800			JRST .+1
09900			SUBI C,60
10000			IMULI C,=10
10100			SKIPE SIGN
10200			MOVN C,C
10300			ADD A,C
10400			PUSH P,A
10500			PUSHJ P,RNUM
10600			JFCL
10700			POP P,A
10800			JRST .+1]	;.+1??
10900		MOVN A,A
11000		LSH A,1			;*2 (MAKE IT STEPS)
11100	   	CAIE C,12	;DID IT GET A LF?
11200		PUSHJ P,INCHLF	;NO, GO LOOK
11300	;CYDEFP:	CAIE C,12
11400	;C	JRST [	CLRBFI
11500	;C  		JRST YAGN1]
11600	YDEF:	ADD A,B
11700		MOVNM A,INIX#
11800	AGAIN:	MOVE A,[FILNAM,,LKENT]
11900		BLT A,LKENT+3
12000		OPEN DSK,[14↔'DSK   '↔IBUF]
12100		JRST 4,.
12200		INBUF DSK,NBUFS
12300		LOOKUP DSK,LKENT
12400		JRST FNF
12500	ASKLEN:	SETZM POOBX#
12600		SETZM POOBY#
12700		PUSHJ P,XINI		;GET X INFO
12800		SETZM XX#
12900		SETZM YY#
13000		MOVEI C,3
13100		HRRZM C,PENN#
13200	READ1:	IN DSK,			;READ FIRST BUFFER
13300		SKIPA     
13400		HALT			;ERROR  
13500		HRR C,IBUF+1
13600		MOVN E,1(C)	;LOOK FOR SIZE FACTOR. IF FOUND SKIP THIS BUFFER.
13700		CAIGE E,177	;FIRST WD HAS SIZE * 1000, NOT WDCNT
13800		MOVNI E,177
13900		JRST PLOTX 	;IF(E.LT.-177)E=-177
14000	
14100	OUTER:	IN DSK,
14200		JRST PLOT
14300		STATO DSK,20000
14400		JRST 4,.
14500		RELEAS DSK,
14600	IFN LSTBIT-1,<PUSHJ P,XFIX>
14700		JRST PCUT
14800	
14900	INCHLF:	INCHWL 0		 ;GET ANOTHER CHARACTER
15000		CAIE 0,12		;WAS IT A LF?
15100		JRST INCHLF		 ;GET THE LF
15200		POPJ P,
     

00100	XINI:	SKIPN GO
00200		OUTSTR [ASCIZ /LENGTH IN INCHES (Y DIMENSION, DEFAULT=11)? /]
00300		SETZM DEFA#
00400		SKIPE GO
00500		JRST PASSD
00600		PUSHJ P,RNUM
00700		SETOM DEFA		;ASSUME 11 INCHES
00800	;C	JUMPLE A,[XINLER:CLRBFI
00900	;CC	JUMPLE A,[XINLER:PUSHJ P,INCHLF
01000		JUMPLE A,[XINLER:INCHWL 0      ; GET LF?
01100			JRST XINI]
01200		SKIPGE DEFA		;? GO?
01300	PASSD:	HRRZI A,=11
01400		SKIPE GO
01500		MOVE A,GO
01600	;;PASSD:	MOVE A,GO		;EITHER 11 OR 14
01700		CAIE C,12
01800		JRST XINLER
01900		IMULI A,=200
02000		PUSH P,A
02100	YINI1:	SKIPE GO
02200		JRST PASS3
02300		SKIPL ROFLG
02400		OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=75)? \]
02500		SKIPGE ROFLG
02600		OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=1000)? \]
02700		PUSHJ P,RNUM
02800	PASS3:	JRST [	MOVEI A,=75
02900			SKIPE BIGBOT	;BIGBOT=NEG=200 BOTTOM MARGIN
03000			MOVEI A,=200
03100			SKIPGE ROFLG
03200			MOVEI A,=1000
03300			JRST IYDEF]
03400		CAIE C,12
03500	;C	JRST [	CLRBFI
03600		JRST [	PUSHJ P,INCHLF
03700			JRST YINI1]
03800	;;IYDEF:	IMULI A,LBUFL+1
03900	;;	MOVEM A,IYPOS#
04000	IYDEF:	MOVEM A,SHIFT#
04100		POP P,A
04200	XDEF:	MOVEM A,LINCNT#		;LINCNT NEVER SEEMS TO REAPPEAR!
04300		MOVEI B,-1(A)
04400		IMULI A,LBUFL+1		;A← BUFSIZ ← ROWS * COL
04500		MOVE T,JOBFF		;GET START ADDR
04600		MOVEM T,XGPPTR
04700		SOS XGPPTR
04800		MOVEI T,2(A)
04900		MOVNI TT,(T)
05000		ADD T,XGPPTR
05100		HRLM TT,XGPPTR		;XGPPTR← -WDCNT,,ADDR-1
05200		MOVE TT,T
05300	
05400		HRRZ L,XGPPTR
05500		MOVSI T,1(L)
05600		HRRI T,2(L)
05700	 	SETZM 1(L)
05800	 	MOVE U,JOBREL
05900	 	BLT T,(U)		;ZERO TO END OF CORE
06000		HRRZI U,(TT)
06100		MOVEM B,SVBBB#
06200		
06300	;;	MOVE Y,IYPOS
06400	;;	ADDI Y,2(L)
06500		MOVEI Y,2(L)
06600		MOVEI XD,DBUF+1
06700		SKIPL A,INIX		;WHERE DO WE START
06800		JRST MAYBON
06900		SUBI A,43
07000		IDIV A,[-44]
07100		HRLOI X,XD
07200		SOJA A,SETB
07300	
07400	MAYBON:	ADDI A,43
07500		IDIVI A,44
07600		CAILE A,LBUFL
07700		JRST OFFRT
07800		MOVE X,A
07900		SETZ A,
08000		HRLI X,Y
08100		JRST SETB
08200	
08300	OFFRT:	MOVE X,[XD,,LBUFL]
08400		SUBI A,LBUFL
08500	SETB:	MOVE B,INIX
08600		IDIVI B,44
08700		MOVSI B,400000
08800		MOVN C,C
08900		ROT B,(C)
09000		POPJ P,
09100	
09200	POPJ1:	AOS (P)
09300	CPOPJ:	POPJ P,
09400	
     

00100		MOVE A,E	;ROTATION
00200	ROTA:	MOVE 14,2(A)
00300		LSHC 14,-10
00400		HLLZ C,15
00500		LSHC 14,-16
00600		HLLZ D,15
00700		LSHC 14,-16
00800		EXCH 15,D
00900		LSHC 14,16
01000		ASH D,-26
01100		MOVN 15,D
01200		LSH 15,26
01300		LSHC 14,16
01400		HLLZ 15,C
01500		LSHC 14,10
01600		MOVEM 14,2(A)
01700		AOBJN A,ROTA
01800		JRST PLOT1
01900	
02000	PLOT:	HRR C,IBUF+1
02100		MOVN E,1(C)	;FIX FOR NO WDCNT
02200	PLOTX:	MOVSI E,(E)
02300		HRR E,IBUF+1
02400		SKIPGE ROFLG
02500		JRST ROTA-1
02600	PLOT1:	MOVE 14,2(E)
02700		LSHC 14,-10
02800		ASH 15,-34
02900		MOVEM 15,SVPEN#		;GET PEN CODE
03000		MOVM A,15
03100		LSHC 14,-16
03200		ASH 15,-26
03300		SKIPL SVPEN
03400		ADD 15,SHIFT		;SHIFT UP OR DOWN
03500		MOVEM 15,SVY#		;GET Y
03600		SUB 15,YY
03700		MOVEM 15,SVYSB#		;SAVE Y DIFF
03800		IMULI 15,LBUFL+1
03900		ADD 15,Y
04000		MOVEM 15,SVYOD#		;SAVE NEW Y
04100		CAIGE 15,(L)		;OFF TOP
04200		JRST LOSE
04300		CAIL 15,-LBUFL-1(U)	;OFF BOTTOM
04400		JRST LOSE
04500		LSHC 14,-16
04600		ASH 15,-26
04700		MOVEM 15,SVX#		;GET X
04800		SUB 15,XX
04900		MOVE 0,15		;0 HAS X DIFF
05000		HRRZ 16,X
05100		IMULI 16,44	;TIMES BITS INA WORD
05200		JFFO B,.+1	
05300		ADD 16,C	;PLUS REMAINDER EQ OLD X
05400		SUB 16,15
05500		JUMPL 16,LOSEX
05600		CAILE 16,=1727
05700		JRST LOSEX
05800		SKIPE OOBFLG#		;CK IF ALREADY OOB
05900		JRST OOBAR
06000	FIXUP:	CAIE A,1	;FIXUP WHAT?
06100		HRRM A,PENN
06200		HRR A,PENN	;SAME PEN IF 1
06300		CAIN A,3
06400		JRST PENUP	;PENUP IF 3
06500		MOVE C,SVYSB	;Y DIFF
06600		IORM B,@X	;MARK NOW X Y
06700				;FIND DIRECTION
06800		JUMPE NORMX	;VERT OR NO MOVE
06900		JUMPL MVLFT	;LEFT
07000		JUMPE C,NRT	;HORZ
07100		JUMPL C,MVDWN	;DOWN
07200		CAMLE C,0	;JUMP IF Y DIFF > X DIFF
07300		JRST XCHA
07400	
07500		SETZ 14,	;↓↓ MOVE UP AND RIGHT
07600		TLNE C,200000
07700		JRST .+4
07800		LSH C,1
07900		TRO C,1
08000		AOJA 14,.-4
08100		SUBI 14,=34
08200		IDIV C,0
08300		MOVNS 14
08400		LSH C,(14)
08500		SETZ 15,
08600	INLOOP:	ADD 15,C
08700		TLZE 15,200000
08800		ADDI Y,LBUFL+1
08900		SKIPGE B
09000		SOJ X,
09100		ROT B,1
09200		IORM B,@X
09300		SOJG INLOOP
09400		JRST DONXT
09500	
     

00100	XCHA:	SETZ 14,	;↓↓MOVE UP AND RIGHT
00200		TLNE 0,200000
00300		JRST .+4
00400		LSH 0,1
00500		TRO 0,1
00600		AOJA 14,.-4
00700		SUBI 14,=34
00800		IDIV 0,C
00900		MOVNS 14
01000		LSH 0,(14)
01100		SETZ 15,
01200	INLOO:	ADD 15,0
01300		TLZN 15,200000
01400		JRST MVUP
01500		SKIPGE B
01600		SOJ X,
01700		ROT B,1
01800	MVUP:	ADDI Y,LBUFL+1
01900		IORM B,@X
02000		SOJG C,INLOO
02100		JRST DONXT
02200	
02300	MVDWN:	MOVMS C		;↓↓MOVE DOWN AND RIGHT
02400		CAMLE C,0
02500		JRST XCHA2	;JUMP IF YDIFF > XDIFF
02600		SETZ 14,
02700		TLNE C,200000
02800		JRST .+4
02900		LSH C,1
03000		TRO C,1
03100		AOJA 14,.-4
03200		SUBI 14,=34
03300		IDIV C,0
03400		MOVNS 14
03500		LSH C,(14)
03600		SETZ 15,
03700	INLOP:	ADD 15,C
03800		TLZE 15,200000
03900		SUBI Y,LBUFL+1
04000		SKIPGE B
04100		SOJ X,
04200		ROT B,1
04300		IORM B,@X
04400		SOJG INLOP
04500		JRST DONXT
04600	
04700	XCHA2:	SETZ 14,	;↓↓MOVE DOWN AND RIGHT
04800		TLNE 0,200000
04900		JRST .+4
05000		LSH 0,1
05100		TRO 0,1
05200		AOJA 14,.-4
05300		SUBI 14,=34
05400		IDIV 0,C
05500		MOVNS 14
05600		LSH 0,(14)
05700		SETZ 15,
05800	INOOP:	ADD 15,0
05900		TLZN 15,200000
06000		JRST MVEX
06100		SKIPGE B
06200		SOJ X,
06300		ROT B,1
06400	MVEX:	SUBI Y,LBUFL+1
06500		IORM B,@X
06600		SOJG C,INOOP
06700		JRST DONXT
06800	
06900	NRT:	JUMPL B,GOOP	;HORZ RIGHT
07000	TOOT:	ROT B,1
07100		IORM B,@X
07200		SOJG 0,NRT
07300		JRST DONXT
07400	GOOP:	SOJ X,
07500		CAIGE 0,44
07600		JRST TOOT
07700		IDIVI 0,44
07800		SETOM @X
07900		SOJ X,
08000		SOJG 0,.-2
08100		HRR 0,1
08200		JUMPN 0,TOOT
08300		AOJ X,
08400		JRST DONXT
08500	
08600	NLFT:	MOVMS 0		;HORZ LEFT
08700		ROT B,-1
08800		JUMPL B,ROOT
08900	WOOP:	IORM B,@X
09000		SOJG 0,.-3
09100		JRST DONXT
09200	ROOT:	AOJ X,
09300		CAIGE 0,44
09400		JRST WOOP
09500		IDIVI 0,44
09600		SETOM @X
09700		AOJ X,
09800		SOJG 0,.-2
09900		HRR 0,1
10000		JUMPN 0,WOOP
10100		SOJ X,
10200		ROT B,1
10300		JRST DONXT
10400	NORMX:	JUMPE C,NOMOVE	;NO DIFF
10500		JUMPL C,MDOWN	;MOVE VERT DOWN
10600	MUP:	ADDI Y,LBUFL+1	;MOVE VERT UP
10700		IORM B,@X
10800		SOJG C,MUP
10900		JRST DONXT
11000	MDOWN:	SUBI Y,LBUFL+1	;MOVE VERT DOWN
11100		IORM B,@X
11200		AOJL C,MDOWN
11300	DONXT:	MOVE 4,SVX	;DONE. NOW UPDATE X AND Y
11400		MOVEM 4,XX
11500	NXTY:	MOVE 4,SVY
11600		MOVEM 4,YY
11700	NOMOVE:	SKIPL SVPEN
11800		JRST ENOUT
11900		SETZM XX	;IF NEW LOCO
12000		SETZM YY
12100	ENOUT:	AOBJN E,PLOT1	;GET NEXT
12200		JRST OUTER
12300	
     

00100	MVLFT:	MOVMS 0		;MOVE LEFT THEN RIGHT
00200		MOVMS 15
00300		JUMPE C,NLFT
00400		HRR Y,SVYOD
00500		IDIVI 15,44
00600		ADD X,15
00700	XEND:	SOJL 16,DUN
00800		ROT B,-1
00900		JUMPGE B,XEND
01000		AOJ X,
01100		JRST XEND
01200	DUN:	MOVEM X,XX	;SAVE NEW X POS
01300		MOVEM B,YY
01400		IORM B,@X
01500		JUMPL C,MVLD
01600		CAMLE C,0
01700		JRST XCHA3
01800		SETZ 14,	;MOVE LEFT UP
01900		TLNE C,200000
02000		JRST .+4
02100		LSH C,1
02200		TRO C,1
02300		AOJA 14,.-4
02400		SUBI 14,=34
02500		IDIV C,0
02600		MOVNS 14
02700		LSH C,(14)
02800		SETZ 15,
02900	ILOOP:	ADD 15,C
03000		TLZE 15,200000
03100		SUBI Y,LBUFL+1
03200		SKIPGE B
03300		SOJ X,
03400		ROT B,1
03500		IORM B,@X
03600		SOJG ILOOP
03700		JRST BFOR
03800	
03900	XCHA3:	SETZ 14,
04000		TLNE 0,200000
04100		JRST .+4
04200		LSH 0,1
04300		TRO 0,1
04400		AOJA 14,.-4
04500		SUBI 14,=34
04600		IDIV 0,C
04700		MOVNS 14
04800		LSH 0,(14)
04900		SETZ 15,
05000	ILOP:	ADD 15,0
05100		TLZN 15,200000
05200		JRST DOQ
05300		SKIPGE B
05400		SOJ X,
05500		ROT B,1
05600	DOQ:	SUBI Y,LBUFL+1
05700		IORM B,@X
05800		SOJG C,ILOP
05900		JRST BFOR
06000	
06100	MVLD:	MOVMS C		;MOVE LEFT DOWN
06200		CAMLE C,0
06300		JRST XCHA4
06400		SETZ 14,
06500		TLNE C,200000
06600		JRST .+4
06700		LSH C,1
06800		TRO C,1
06900		AOJA 14,.-4
07000		SUBI 14,=34
07100		IDIV C,0
07200		MOVNS 14
07300		LSH C,(14)
07400		SETZ 15,
07500	LOOP:	ADD 15,C
07600		TLZE 15,200000
07700		ADDI Y,LBUFL+1
07800		SKIPGE B
07900		SOJ X,
08000		ROT B,1
08100		IORM B,@X
08200		SOJG LOOP
08300		JRST BFOR
08400	
08500	XCHA4:	SETZ 14,
08600		TLNE 0,200000
08700		JRST .+4
08800		LSH 0,1
08900		TRO 0,1
09000		AOJA 14,.-4
09100		SUBI 14,=34
09200		IDIV 0,C
09300		MOVNS 14
09400		LSH 0,(14)
09500		SETZ 15,
09600	LOP:	ADD 15,0
09700		TLZN 15,200000
09800		JRST DOP
09900		SKIPGE B
10000		SOJ X,
10100		ROT B,1
10200	DOP:	ADDI Y,LBUFL+1
10300		IORM B,@X
10400		SOJG C,LOP
10500	
10600	BFOR:	HRR Y,SVYOD	;RESTORE PEN TO NEW PEN
10700		MOVE X,XX
10800		MOVE B,YY
10900		JRST DONXT
11000	
     

00100	OOBAR:	SETZM OOBFLG	; GET HERE IF ALL READY OOB
00200		AOSG SSS	; THIS IS FOR THE FIRST OOB FROM MP
00300		JRST FIXUP	;
00400	PENUP:	HRR Y,SVYOD	; PEN IS UP GET NEW Y
00500		JUMPE 15,NXTY	;IF VERT
00600		JUMPL 15,PULFT	;IF LEFT
00700		CAIGE 15,44	;↓↓MOVE UP PEN RIGHT TO NEW X
00800		JRST XLOOP
00900		IDIVI 15,44
01000		SUB X,15
01100		HRR 15,16
01200	XLOOP:	SOJL 15,DONXT
01300		SKIPGE B
01400		SOJ X,
01500		ROT B,1
01600		JRST XLOOP
01700	
01800	PULFT:	MOVMS 15	;↓↓MOVE UP PEN LEFT TO NEW X
01900		CAIGE 15,44
02000		JRST OOO
02100		IDIVI 15,44
02200		ADD X,15
02300		HRR 15,16
02400	OOO:	SOJL 15,DONXT
02500		ROT B,-1
02600		JUMPGE B,OOO
02700		AOJ X,
02800		JRST OOO
02900	
03000	LOSEX:	SETOM OOBFLG	;OOB X
03100		SKIPE POOBX
03200		JRST PENUP
03300		SETOM POOBX
03400		PUSHJ P,DETCHK
03500	 	 PUSHJ P,XERR
03600		PUSHJ P,ERRPNT
03700		ASCIZ /POINT OUT OF BOUNDS, /
03800		JUMPL 16,[PUSHJ P,ERRPNT
03900			  ASCIZ/-X/
04000			  JRST PENUP]
04100		PUSHJ P,ERRPNT
04200		ASCIZ/+X/
04300		JRST PENUP
04400	
04500	LOSE:	SETOM OOBFLG	;OOB Y
04600		SKIPE POOBY
04700		JRST LOBAC
04800		SETOM POOBY
04900		PUSHJ P,DETCHK
05000		PUSHJ P,XERR
05100		PUSHJ P,ERRPNT
05200		ASCIZ /POINT OUT OF BOUNDS, /
05300		CAIGE 15,(L)
05400		JRST [	PUSHJ P,ERRPNT
05500			ASCIZ/-Y/
05600			JRST LOBAC]
05700		PUSHJ P,ERRPNT
05800		ASCIZ/+Y/
05900	LOBAC:	LSHC 14,-16
06000		ASH 15,-26
06100		MOVEM 15,SVX
06200		SUB 15,XX
06300		JRST PENUP
06400	
06500	DECOUT:	IDIVI T,=10	;DEC TTY OUT
06600		HRLM TT,(P)
06700		SKIPE T
06800		PUSHJ P,DECOUT
06900		HLRZ TT,(P)
07000		ADDI TT,60
07100		ROT TT,-7
07200		MOVEM TT,.+2
07300		PUSHJ P,ERRPNT
07400		0
07500		POPJ P,
07600	
07700	ERRPNT:	HRRZ TT,(P)		;ERROR TTY OUT
07800		MOVEM TT,PNTR
07900		MOVEI TT,LINE
08000		TTYMES TT,
08100		JRST [	OUTSTR[ASCIZ/TTYMES FAILED	/]
08200			OUTSTR @PNTR
08300			OUTSTR[ASCIZ/
08400	/]
08500			JRST .+1]
08600		POP P,TT
08700		HRL TT,(TT)
08800		TLNE TT,376
08900		AOJA TT,.-2
09000		JRST 1(TT)
09100	
09200	XERR:	PUSHJ P,ERRPNT		;DET TTY OUT
09300		ASCIZ/
09400	MESSAGE FROM X WORKING ON /
09500		MOVE TT,FILNAM
09600		PUSHJ P,SIXOUT
09700		PUSHJ P,ERRPNT
09800		ASCIZ/./
09900		HLLZ TT,FILEXT
10000		PUSHJ P,SIXOUT
10100		PUSHJ P,ERRPNT
10200		ASCIZ/[/
10300		MOVE TT,FILPPN
10400		PUSHJ P,SIXOUT
10500		PUSHJ P,ERRPNT
10600		ASCIZ/] : /
10700		POPJ P,
10800	
10900	SIXOUT:	JUMPE TT,CPOPJ		;SIXBIT OUT
11000		SETZ T,
11100		LSHC T,6
11200		ADDI T,40
11300		PUSH P,TT
11400		ROT T,-7
11500		MOVEM T,.+2
11600		PUSHJ P,ERRPNT
11700		0
11800		POP P,TT
11900		JRST SIXOUT
12000	
12100	DETCHK:	SETOM DET#	;CK FOR DET JOB
12200		GETLIN DET
12300		HRRES DET
12400		SKIPL DET
12500		AOS (P)
12600		POPJ P,
12700	
     

00100	FINDL:	HRRZ A,JOBREL		;CK IF BIG ENUF
00200		CAIL A,-LBUFL-1(U)
00300		JRST XINL-1
00400	XL2:	MOVEM TT,(T)		;ADD MORE AND MARK
00500		ADDI T,LBUFL+1
00600		CAIGE T,(A)
00700		JRST XL2
00800		SUBI A,(L)
00900		MOVNS A
01000		HRLM A,XGPPTR
01100		SUBI T,LBUFL+1
01200		JRST XXOUT
01300	
01400	PCUT:	HRRZ L,XGPPTR				;MARK BLOCK FOR XGP
01500		MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
01600		MOVEM TT,1(L)		;FIRST ONE HAS MARK AND CUT WITH IT
01700		TLZ TT,400000		;DELETE MARK AND CUT
01800		MOVEI T,1+LBUFL+1(L)
01900		SKIPGE DEFA
02000		JRST FINDL
02100		MOVE B,SVBBB
02200	XINL:	MOVEM TT,(T)
02300		ADDI T,LBUFL+1
02400		SOJG B,XINL
02500		HLRO TT,XGPPTR
02600		MOVNS TT
02700		ADDI TT,(L)
02800		MOVE A,(TT)
02900	XXOUT:	MOVSI TT,400100
03000		MOVEM TT,(T)		;SO DOES LAST
03100	
03200		SKIPN SPREAD
03300		JRST XGPOUT
03400	
03500		HRRZ T,XGPPTR
03600		ADDI T,LBUFL+1
03700		HRRZ C,SVBBB
03800	
03900		SKIPG SPREAD
04000		JRST NINE
04100	
04200	XLINE4:	HRLI T,-LBUFL
04300	
04400	XSHFT4:	MOVE A,2(T)
04500		MOVE B,3(T)
04600		ROTC A,1
04700		ORM A,2(T)
04800		AOBJN T,XSHFT4
04900		AOJ T,
05000		SOJG C,XLINE4
05100	
05200		HRRZ T,XGPPTR
05300		HRRZ B,SVBBB
05400		
05500	YLINE4:	HRLI T,-LBUFL
05600	
05700	YSHFT4:	MOVE A,LBUFL+3(T)
05800		ORM A,2(T)
05900		AOBJN T,YSHFT4
06000		AOJ T,		;Bump past control word.
06100		SOJG B,YLINE4
06200	
06300		JRST XGPOUT
06400	
06500	NINE:	HRLI T,-LBUFL
06600	
06700	XSHFT9:	MOVE A,2(T)
06800		MOVE B,3(T)
06900		ROTC A,1
07000		ORM A,2(T)
07100		ROTC A,1
07200		ORM A,2(T)
07300		AOBJN T,XSHFT9
07400		AOJ T,
07500		SOJG C,NINE
07600	
07700		HRRZ T,XGPPTR
07800		HRRZ B,SVBBB
07900	
08000	YLINE9:	HRLI T,-LBUFL
08100	
08200	YSHFT9:	MOVE A,LBUFL+LBUFL+4(T)
08300		OR A,LBUFL+3(T)
08400		ORM A,2(T)
08500		AOBJN T,YSHFT9
08600		AOJ T,
08700		SOJG B,YLINE9
08800	
08900	XGPOUT:	OPEN XGP,XNIT		;XGP OUTPUT
09000	;;;	PUSHJ P,NOXGP
09100		JRST NOXGP
09200		OUTSTR[ASCIZ/CRANKING XGP
09300	/]
09400		LOCK
09500	OUTIT:	OUT XGP,XGPPTR
09600		JRST OUTOK
09700	DSKERR:	PUSHJ P,DETCHK
09800		PUSHJ P,XERR
09900		PUSHJ P,ERRPNT
10000		ASCIZ /XGP OUTPUT ERROR.
10100	/
10200	OUTOK:	UNLOCK
10300		RELEAS XGP,
10400	XMORE:	PUSHJ P,DETCHK
10500	;;	JRST DODEL			;DELETE AUTOMATICALLY IF DETACHED
10600		JFCL
10700		OUTSTR[ASCIZ/D=DELETE, R=REPEAT, X=EXIT  /]
10800		INCHRW C
10900		CAIE C,15
11000		JRST .+3
11100		INCHRW C
11200		JRST XMORE+2			; WON'T ACCEPT JUST CRLF
11300		OUTSTR[ASCIZ/
11400	/]
11500		CAIE C,"X"
11600		CAIN C,"x"
11700		SKIPA
11800		JRST .+3
11900		PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
12000		JRST NODEL 
12100		CAIE C,"R"
12200		CAIN C,"r"
12300		JRST XGPOUT
12400		CAIE C,"D"
12500		CAIN C,"d"
12600		SKIPA   			;IF NOT R, X OR D TRY AGAIN.
12700		JRST XMORE+2
12800		PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
12900	DODEL:	MOVE A,[FILNAM,,LKENT]
13000		BLT A,LKENT+3
13100		INIT DSK,17
13200		'DSK   '
13300		0
13400		JRST [	SKIPGE DET
13500			PUSHJ P,XERR
13600			PUSHJ P,ERRPNT
13700			ASCIZ/COULDN'T GET DISK FOR DELETE!
13800	/
13900			JRST NODEL]
14000		LOOKUP DSK,LKENT
14100		JRST [	SKIPGE DET
14200			PUSHJ P,XERR
14300			PUSHJ P,ERRPNT
14400			ASCIZ/LOOKUP FOR DELETE FAILED!
14500	/
14600			JRST NODEL]
14700		MOVE A,FILPPN
14800		MOVEM A,LKENT+3
14900		SETZM LKENT
15000		RENAME DSK,LKENT
15100		CAIA
15200		JRST NODEL
15300		SKIPGE DET
15400		PUSHJ P,XERR
15500		PUSHJ P,ERRPNT
15600		ASCIZ/RENAME FOR DELETE FAILED!
15700	/
15800	NODEL:	RELEASE DSK,
15900		SKIPGE DET
16000		PUSHJ P,XERR
16100		PUSHJ P,ERRPNT
16200		ASCIZ/ALL DONE!
16300	/
16400		CALLI 12		;LEAVE
16500	
16600	NOXGP:	PUSHJ P,DETCHK
16700		PUSHJ P,XERR
16800		PUSHJ P,ERRPNT
16900	   	ASCIZ /
17000	WAITING FOR XGP /
17100	;ZZ	ASCIZ /
17200	;ZZXGP BUSY, OUTPUT TO DISK? /
17300	;ZZ	INCHRW A
17400	;ZZ	CAIE A,"Y"
17500	;ZZ	CAIN A,"y"
17600	;ZZ	JRST OUTFIL
17700		HRRZI A,1017
17800		HRRZM A,XNIT
17900	;;;	POPJ P,
18000		JRST XGPOUT
18100	
18200	XNIT:	417
18300		'XGP   '
18400		0
18500	XGPPTR:	BLOCK 2
18600	
18700	IFN LSTBIT-1,<
18800	XFIX:	MOVE A,[LSTBIT-1]
18900		HRRZ C,JOBREL
19000		HRRZ D,XGPPTR
19100	XFIXL:	ANDCAM A,LBUFL-1+2(D)
19200		ADDI D,LBUFL+1
19300		CAIGE D,(C)
19400		JRST XFIXL
19500		POPJ P,
19600	>
19700	CORDWN:	MOVE T,JOBFF
19800		SUBI T,1
19900		CALLI T,11
20000		JRST 4,.
20100		POPJ P,
20200	
     

00100	INBITS:	PUSHJ P,NAMGET		;INPUT OLD BIT FILE
00200		HRRZ U,JOBFF
00300		HRRZI T,177(U)
00400		CORE T,
00500		JRST INBITS
00600		SOJ U,
00700		HRLI U,-200
00800		OPEN [17↔'DSK   '↔0]
00900		JRST INBITS
01000		LOOKUP FILNAM
01100		JRST INBITS
01200		SETZ 10,
01300	TRYTRY:	OPEN XGP,XNIT	  ;***** GRAB THE XGP BEFORE CORE EXPANSION
01400		JRST NONO    	 ;CAN'T GET IT!
01500		INPUT U
01600		MOVE T,[BYTE (12)4001,LMAR,LBUFL]
01700		EXCH T,1(U)
01800		HLL U,T
01900		MOVEM U,XGPPTR
02000		HRLI U,(T)
02100		TLNN U,777777
02200		JRST CLOZE
02300		ADDI U,200
02400		MOVNI T,(T)
02500		ADDI T,(U)
02600		CORE T,
02700		JRST INBITS	;HANG
02800		INPUT U
02900	CLOZE:	RELEAS
03000		JRST XGPOUT
03100	
03200	NONO:	OUTSTR[ASCIZ/
03300	WAITING FOR XGP  /]
03400		HRRZI A,1017
03500		HRRZM A,XNIT
03600		JRST TRYTRY
03700	
03800	OUTFIL:	PUSHJ P,NAMGET		;OUTPUT BIT FILE
03900		MOVE U,XGPPTR
04000		HLRO T,U
04100		MOVNS T
04200		TRZ T,177
04300		HRRZI A,200(T)
04400		ADDI A,(U)
04500		CORE A,
04600		JRST OUTFIL
04700		MOVNS T
04800		HLL T,U			;FIRST WD IS WC-200,-WC
04900		MOVEM T,1(U)
05000		HRLI U,-200(T)
05100		SETZ 10,
05200		OPEN [17↔'DSK   '↔0]
05300		JRST 4,.
05400		ENTER FILNAM
05500		CAIA
05600		OUTPUT U
05700		RELEAS
05800		JRST NODEL
05900	
     

00100	;CORUP
00200	
00300	CORUP:
00400	
00500	REPEAT 0,<	OLD WAY - FLUSHED BY REG 1-3-76
00600	
00700		HRRZ B,JOBCNI
00800		CAIE B,20000
00900		DISMIS
01000		MOVE A,JOBTPC
01100		MOVEM A,IPC+1
01200		UWAIT
01300		DEBREAK
01400	>;END REPEAT 0
01500	
01600	BUST:	MOVEM	1,SVONE#
01700	 	MOVEM	2,SVTWO#
01800		MOVEM	TT,SVTTT#
01900		MOVE	1,JOBCNI	;REG  GET APR CONI BITS
02000		TRNN	1,20000		;REG  IS THERE AN MPV?
02100		JRST	NOMPV		;REG  NO
02200		HRRZ	1,JOBREL	;OLD CORE SIZE
02300		MOVSI	2,1(1)		;FIRST NEW WORD WE'LL GET
02400		HRRI	2,2(1)		;SECOND NEW WORD  - 2 HAS A BLT POINTER.
02500		ADDI	1,16000
02600	;;	ADDI	1,10000		;GET ANOTHER 8K
02700		MOVE	TT,1
02800		CORE	1,
02900		PUSHJ	P,CORLUZ
03000		HRRZ	1,JOBREL
03100		SETZM	-1(2)
03200	 	BLT	2,(1)		;ZERO NEW CORE
03300		MOVE	1,SVONE
03400	 	MOVE	2,SVTWO
03500		MOVE	TT,SVTTT
03600	
03700	REPEAT 0,<
03800		INTJEN IPC
03900	>
04000	
04100		JRST	2,@JOBTPC	;REG  THIS IS HOW TO DISMISS OLD INTERRUPT
04200	
04300	NOMPV:	OUTSTR	[ASCIZ/UNEXPECTED INTERRUPT?
04400	/]
04500		JRST	2,@JOBTPC
04600	
04700	CORLUZ:	MOVE T,TT
04800		LSH T,-12
04900		PUSH P,T
05000		PUSHJ P,DETCHK
05100		PUSHJ P,XERR
05200		POP P,T
05300		PUSHJ P,DECOUT
05400		PUSHJ P,ERRPNT
05500		ASCIZ / K OF CORE NEEDED!
05600	/
05700		SKIPGE DET
05800		CALLI 12
05900		JRST ASKLEN
06000	
06100	FNF:	PUSHJ P,DETCHK		;FILE NOT FOUND
06200		PUSHJ P,XERR
06300		PUSHJ P,ERRPNT
06400		ASCIZ /LOOKUP FAILED.
06500	/
06600		SKIPGE DET
06700		CALLI 12
06800		JRST FILIN
06900	
     

00100	;******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********
00200	
00300	FRD:	MOVSI A,'PLT'		;FILE SCAN
00400		MOVEM A,FILEXT
00500		SKIPN GO
00600		JRST .+3		;GO?
00700		MOVEI C,12		; CR
00800		JRST .+3
00900		PUSHJ P,GETNAM
01000		CAME A,[SIXBIT/G/]	;G ALONE = 'GO'
01100		JRST GOX
01200		SETOM GO		;GO BACK AND USE DEFAULT NAME.
01300		POPJ P,
01400	
01500	;;GOX:	CAME A,[SIXBIT/:/]	;FOR * FOUR
01600	GOX:	CAME A,[SIXBIT/4/]	;FOR * FOUR
01700		JRST CKSEMI
01800		AOS SPREAD
01900	POPBAC:	POP P,A
02000		PUSHJ P,INCHLF
02100	;C	CLRBFI
02200		JRST FILIN
02300	CKSEMI:	CAME A,[SIXBIT/9/]		;FOR * NINE
02400	;;CKSEMI:	CAME A,[SIXBIT/;/]
02500		JRST CKDEFA
02600		SETOM SPREAD
02700		JRST POPBAC
02800	CKDEFA:	SKIPN A
02900	 	MOVE A,['PLT   ']
03000	    	MOVEM A,FILNAM
03100		CAIE C,"."
03200		JRST NOEXT
03300		PUSHJ P,GETNAM
03400		MOVEM A,FILEXT
03500	NOEXT:	CAIE C,"["
03600		JRST FRDX
03700		PUSHJ P,GETP
03800		HRLZM A,FILPPN
03900		PUSHJ P,GETP
04000		HRRM A,FILPPN
04100	FRDX:	SKIPN GO
04200		INCHRW C
04300		CAIE C,12
04400		JRST FRDX
04500		POPJ P,
04600	
04700	RNUM:	INCHWL C		;NUM SCAN
04800		CAIN C,15
04900		JRST RNUM
05000		CAIN C,12
05100		POPJ P,
05200		AOS (P)
05300		MOVEI A,
05400		SETZM SIGN
05500		CAIN C,"-"
05600		JRST [	PUSHJ P,RNUML
05700			SETOM SIGN
05800			MOVN A,A
05900			POPJ P,]
06000		CAIN C,"+"
06100	RNUML:	INCHWL C
06200		CAIL C,"0"
06300		CAILE C,"9"
06400		JRST RNUMX
06500		IMULI A,12
06600		ADDI A,-"0"(C)
06700		JRST RNUML
06800	
06900	RNUMX:	CAIN C,15
07000		INCHRW C
07100		POPJ P,
07200	
     

00100	GETNAM:	MOVEI A,		;FILE SCAN
00200		MOVE B,[440600,,A]
00300	GETNML:	PUSHJ P,RCH
00400		POPJ P,
00500		SUBI C,40
00600		TLNE B,770000
00700		IDPB C,B
00800		JRST GETNML
00900	
01000	GETP:	MOVEI A,
01100	GETPL:	PUSHJ P,RCH
01200		POPJ P,
01300		TRNE A,770000
01400		JRST GETPL
01500		LSH A,6
01600		ADDI A,-40(C)
01700		JRST GETPL
01800	
01900	RCH:	INCHWL C
02000		CAIN C,42
02100		JRST RCHQ
02200		CAIE C,11
02300		CAIN C," "
02400		JRST RCH
02500		CAIE C,"."
02600		CAIN C,","
02700		POPJ P,
02800		CAIE C,"["
02900		CAIN C,"]"
03000		POPJ P,
03100	RCHQR:	CAIGE C,40
03200		POPJ P,
03300		CAIL C,"a"
03400		CAILE C,"z"
03500		CAIA
03600		SUBI C,40
03700		JRST POPJ1
03800	
03900	RCHQ:	INCHWL C
04000		JRST RCHQR
04100	
04200	;CNAMGET:	CLRBFI
04300	;CCNAMGET:	INCHWL 0
04400	;CC	INCHWL 0	;GET CRLF
04500	;CC	INCHWL 0
04600	;CC	INCHWL 0	;GET CRLF
04700	NAMGET:	PUSHJ P,INCHLF
04800		OUTSTR [ASCIZ/
04900		FILE = /]
05000		SETZM FILEXT+1
05100		SETZM FILPPN
05200		MOVSI A,'BIT'
05300		MOVEM A,FILEXT
05400		PUSHJ P,GETNAM
05500		SKIPN A
05600	 	MOVE A,['PLT   ']
05700	    	MOVEM A,FILNAM
05800		CAIE C,"."
05900		JRST NOEXTN
06000		PUSHJ P,GETNAM
06100		MOVEM A,FILEXT
06200	NOEXTN:	CAIE C,"["
06300		JRST FFDX
06400		PUSHJ P,GETP
06500		HRLZM A,FILPPN
06600		PUSHJ P,GETP
06700		HRRM A,FILPPN
06800	FFDX:	INCHRW C
06900		CAIE C,12
07000		JRST FFDX
07100		POPJ P,
07200	
     

00100	FILNAM:	0			;GLOPS OF JUNK
00200	FILEXT:	0
00300		0
00400	FILPPN:	0
00500	
00600	LKENT:	BLOCK 4
00700	
00800	XGSNAM:	0
00900	XGSEXT:	0
01000		0
01100	XGSPPN:	0
01200	
01300	IBUF:	BLOCK 3
01400	
01500	BITTAB:	FOR I←43,0,-1{1⊗I
01600	}
01700	BYTTAB:	FOR I←36,0,-6{REPEAT 6,{77⊗I}}
01800	
01900	DBUF:	BLOCK LBUFL+2
02000	
02100	PDL:	BLOCK LPDL
02200	
02300	END BEG